COVID in Ireland
Aidan Boland
01 Oct 2020
Information on the data can be found at this link.
# The data must be downloaded and unzipped, there are multiple files in the zip which are needed
directory_to_use <- "data/"
download.file("https://opendata.arcgis.com/datasets/d9be85b30d7748b5b7c09450b8aede63_0.zip?outSR=%7B%22latestWkid%22%3A3857%2C%22wkid%22%3A102100%7D",
file.path(directory_to_use, "Covid19CountyStatisticsHPSCIreland.zip"))
utils::unzip(file.path(directory_to_use, "Covid19CountyStatisticsHPSCIreland.zip"),
exdir = directory_to_use)
covid_openddata_shpdata <- rgdal::readOGR(dsn = file.path(directory_to_use, "Covid19CountyStatisticsHPSCIreland.shp"), stringsAsFactors = F)## OGR data source with driver: ESRI Shapefile
## Source: "/Users/aidanboland/Git/TutoR/Code_Walkthrough/COVID/data/Covid19CountyStatisticsHPSCIreland.shp", layer: "Covid19CountyStatisticsHPSCIreland"
## with 5000 features
## It has 16 fields# Create data frame containing the polygon coordinates
county_polygon_data <- broom::tidy(covid_openddata_shpdata, region = "CountyName")
# write.csv(county_polygon_data, file = file.path(directory_to_use, "county_polygon.csv"), row.names = F) # Optional save county polygon data
# county_polygon_data <- readr::read_csv(county_polygon_data, file = "data/county_polygon.csv")# Create data frame of the covid stats only, no spatial data
raw_covid_stats <-
covid_openddata_shpdata@data %>%
rename(PopulationCensus16 = Population, ConfirmedCovidCases = ConfirmedC)
# A more up to date dataset (without spatial data)
raw_covid_stats <-
readr::read_csv("http://opendata-geohive.hub.arcgis.com/datasets/d9be85b30d7748b5b7c09450b8aede63_0.csv?outSR={%22latestWkid%22:3857,%22wkid%22:102100}")covid_rolling14 <-
raw_covid_stats %>%
# Remove unneeded columns and parse date
select(CountyName, TimeStamp, PopulationCensus16, ConfirmedCovidCases) %>%
mutate(TimeStamp = as.Date(TimeStamp)) %>%
# Add any missing dates and fill the data for missing dates
group_by(CountyName) %>%
tidyr::complete(TimeStamp = seq(min(as.Date(.$TimeStamp)), # use .$TimeStamp to get global data min
max(as.Date(.$TimeStamp)), # not just the min for the group_by var
by = "day")) %>%
# Ensure the data is arranged by date
arrange(TimeStamp) %>%
tidyr::fill(PopulationCensus16, ConfirmedCovidCases, .direction = "down") %>%
# Calculate the lag and then the cases per day
mutate(lag_cases = lag(ConfirmedCovidCases, 1, default = 0),
new_cases = ConfirmedCovidCases - lag_cases,
new_cases_per100 = 100000 * (new_cases/PopulationCensus16),
# Rolling 14 Day Total
rolling14 = rollsum(new_cases, 14, align = "right", fill = 0),
rolling14_per100 = rollsum(new_cases_per100, 14, align = "right", fill = 0)) %>%
ungroup()Animation
# Animation
rolling14_anim <-
covid_rolling14 %>%
# Filter the data by date
filter(TimeStamp >= "2020-08-01") %>% # Sys.Date() - 50
# Join data to county map data
full_join(county_polygon_data, by = c("CountyName" = "id")) %>%
ggplot() + geom_polygon(aes(x = long, y = lat, group = group, fill = rolling14_per100), colour = "black") +
theme_void() +
theme(text = element_text(size = 14)) +
scale_fill_distiller(palette = "RdYlGn",
# limits = c(0, max(covid_rolling14$rolling14_per100))
) +
coord_quickmap() +
# -Animation-
# Plot elements for animation
transition_time(TimeStamp) +
labs(title = "COVID Rolling 14 Day Cases Per 100,000",
subtitle = 'Up to {format(frame_time, "%B %d")}',
fill = "Cases per 100k")
# Create the animation, nframes and fps will set the speed of the animation
# This can be slow depending on choices
map_anim <-
animate(rolling14_anim,
nframes = 120, fps = 10,
start_pause = 5, end_pause = 20)
anim_save(filename = paste0(directory_to_use, "rolling_14day2_", Sys.Date(),".gif"),
animation = map_anim)Testing Data
testing_csv <-
readr::read_csv("http://opendata-geohive.hub.arcgis.com/datasets/f6d6332820ca466999dbd852f6ad4d5a_0.csv?outSR={%22latestWkid%22:3857,%22wkid%22:102100}")
testing_csv$Date_HPSC <- as.Date(testing_csv$Date_HPSC)
testing_tidy <-
testing_csv %>%
arrange(Date_HPSC) %>%
mutate(lag_labs = lag(TotalLabs),
lag_positive = lag(Positive),
daily_labs = TotalLabs - lag_labs,
daily_positive = Positive - lag_positive,
rolling14_labs = rollsum(daily_labs, 14, align = "right", fill = 0),
rolling14_positive = rollsum(daily_positive, 14, align = "right", fill = 0),
roling14_percentage = 100*(rolling14_positive/rolling14_labs)) %>%
select(Date_HPSC, Tests = rolling14_labs,
`Positive Tests` = rolling14_positive,
`Percentage Positive` = roling14_percentage) %>%
tidyr::pivot_longer(cols = c(Tests, `Positive Tests`, `Percentage Positive`), names_to = "stat", values_to = "rolling14") %>%
mutate(stat = factor(stat, levels = c("Tests", "Positive Tests", "Percentage Positive")))
testing_14_anim <-
testing_tidy %>%
filter(Date_HPSC >= "2020-08-01") %>%
ggplot(aes(x = Date_HPSC, y = rolling14), colour = "black") +
geom_line() +
geom_point() +
facet_wrap(~stat, ncol = 1, scales = "free", ) +
labs(x = "Date", y = "",
title = "Totals for Previous 14 Days") +
theme_light() +
theme(text = element_text(size = 16),
strip.text.x = element_text(size = 20)) +
transition_reveal(Date_HPSC)
test_anim <-
animate(testing_14_anim,
nframes = 120, fps = 10,
start_pause = 5, end_pause = 20)
anim_save(filename = paste0(directory_to_use, "rolling_14day_tests_", Sys.Date(),".gif"),
test_anim = map_anim)library(magick)
map_anim2 <-
animate(rolling14_anim,
nframes = 120, fps = 10,
start_pause = 5, end_pause = 20,
renderer = magick_renderer())
test_anim2 <-
animate(testing_14_anim,
nframes = 120, fps = 10,
start_pause = 5, end_pause = 20,
renderer = magick_renderer())
new_gif <- image_append(c(map_anim2[1], test_anim2[1]))
for(i in 2:120){
combined <- image_append(c(map_anim2[i], test_anim2[i]))
new_gif <- c(new_gif, combined)
}
new_gif